home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Plurals
/
Modules
/
ppl-ll.em
< prev
next >
Wrap
Lisp/Scheme
|
1992-06-02
|
3KB
|
85 lines
; Okay here's the scam, in cmlisp all parallel operations are actually
; done in the same context, I want to use as much of the cmlisp compiler
; as possible so rather than hardwiring the context into the expression
; generated we put a binding in which can be changed at execution time
; this also removes the need for the setter functions.
(defmodule ppl-ll (standard0) ()
(defun make-pfun-name (name)
(make-symbol (format nil "PF-~a" name)))
(defun make-pset-name (name)
(make-symbol (format nil "PS-~a" name)))
(setq pfun-table (make-table))
(setq psetter-table (make-table))
(defun add-pfun (name p-name args)
((setter table-ref) pfun-table name (cons p-name args)))
(defun add-psetter (name p-name args)
((setter table-ref) psetter-table name (cons p-name args)))
(defun get-pfun (name) (table-ref pfun-table name))
(defun get-psetter (name) (table-ref psetter-table name))
(defmacro p-0-fn (fn name other-arg)
(let ((f-name (make-pfun-name name)))
(add-pfun name f-name ())
`(progn
(defun ,f-name ()
(,fn ,@(append `(The-Context)
(if other-arg (list other-arg) ()))))
(export ,f-name))))
(defmacro p-1-fn (fn name other-arg)
(let ((f-name (make-pfun-name name)))
(add-pfun name f-name '(a))
`(progn
(defun ,f-name (a)
(,fn ,@(append `(The-Context a)
(if other-arg (list other-arg) ()))))
(export ,f-name))))
(defmacro p-2-fn (fn name other-arg)
(let ((f-name (make-pfun-name name)))
(add-pfun name f-name '(a b))
`(progn (defun ,f-name (a b)
(,fn ,@(append `(The-Context a b)
(if other-arg (list other-arg) ()))))
(export ,f-name))))
(defmacro p-2-set (fn name other-arg)
(let ((f-name (make-pset-name name)))
(add-psetter name f-name '(a b))
`(progn (defun ,f-name (a b)
(,fn ,@(append `(The-Context a b)
(if other-arg (list other-arg) ()))))
(export ,f-name))))
(defmacro p-3-fn (fn name other-arg)
(let ((f-name (make-pfun-name name)))
(add-pfun name f-name '(a b c))
`(progn (defun ,f-name (a b c)
(,fn ,@(append `(The-Context a b c)
(if other-arg (list other-arg) ()))))
(export ,f-name))))
(defmacro p-3-set (fn name other-arg)
(let ((f-name (make-pset-name name)))
(add-psetter name f-name '(a b c))
`(progn (defun ,f-name (a b c)
(,fn ,@(append `(The-Context a b c)
(if other-arg (list other-arg) ()))))
(export ,f-name))))
(export p-0-fn p-1-fn p-2-fn p-3-fn make-pfun-name add-pfun add-psetter
p-2-set p-3-set get-pfun get-psetter pfun-table psetter-table)
)